package Exporter::Simple;

use 5.008;
use warnings;
use strict;
use Attribute::Handlers;
use File::Slurp;
use base 'Exporter';

our $VERSION = '1.12';
no warnings 'redefine';

sub UNIVERSAL::Exported :ATTR(SCALAR,BEGIN) { export('$', @_) }
sub UNIVERSAL::Exported :ATTR(ARRAY,BEGIN)  { export('@', @_) }
sub UNIVERSAL::Exported :ATTR(HASH,BEGIN)   { export('%', @_) }
sub UNIVERSAL::Exported :ATTR(CODE,BEGIN)   { export('', @_)  }

sub UNIVERSAL::Exportable :ATTR(SCALAR,BEGIN) { exportable('$', @_) }
sub UNIVERSAL::Exportable :ATTR(ARRAY,BEGIN)  { exportable('@', @_) }
sub UNIVERSAL::Exportable :ATTR(HASH,BEGIN)   { exportable('%', @_) }
sub UNIVERSAL::Exportable :ATTR(CODE,BEGIN)   { exportable('', @_) }

# Build a structure in which we remember who wants to export what.  The
# structure is %EXPORTDEF and is built when the attribute handlers run, and
# consulted during import().
#
# An example structure is shown here and is built by declaring the following
# exports in a module that subclasses Exporter::Simple:
#
# our @bar : Exportable(vars) = (2, 3, 5, 7);
# our $foo : Exported(vars)   = 42;
# our %baz : Exported         = (a => 65, b => 66);
#
# sub hello : Exported(greet,uk)   { "hello there" }
# sub askme : Exportable           { "what you will" }
# sub hi    : Exportable(greet,us) { "hi there" }
#
# sub get_foo : Exported(vars)   { $foo }
# sub get_bar : Exportable(vars) { @bar }
# 
# results in:
#
# %EXPORTDEF = 
# --- #YAML:1.0
# MyExport:
#   EXPORT:
#     - hello
#     - get_foo
#   EXPORT_OK:
#     - askme
#     - hi
#     - get_bar
#   EXPORT_TAGS:
#     all:
#       - hello
#       - askme
#       - hi
#       - get_foo
#       - get_bar
#     greet:
#       - hello
#       - hi
#     uk:
#       - hello
#     us:
#       - hi
#     vars:
#       - get_foo
#       - get_bar

sub add {
	my ($arrname, $sigil, $pkg, $symbol, $ref, $attr, $tags) = @_;
	$symbol = *{$symbol}{NAME} if ref $symbol;
	$symbol = "$sigil$symbol";
	$tags = [ $tags || () ] unless ref $tags eq 'ARRAY';

    our %EXPORTDEF;

    # subroutine names are undefined during BEGIN, but import() is called only
    # during BEGIN, so we need to get them from the source code. Kludge...

    if ($symbol eq 'ANON') {
        my @call = caller(5);
        my ($filename, $line) = @call[1,2];

        # only read each source file once
        our $source;
        $source->{$filename} ||= [ read_file($filename) ];

        if ($source->{$filename}[$line-1] =~ /\s*sub\s*(\w+)/) {
            $symbol = $1;
        } # else? Hmm...
    }

    push @{ $EXPORTDEF{$pkg}{$arrname} } => $symbol unless
        grep { $_ eq $symbol } @{ $EXPORTDEF{$pkg}{$arrname} };

    for my $tag (@$tags, 'all') {
        push @{ $EXPORTDEF{$pkg}{EXPORT_TAGS}{$tag} } => $symbol
            unless grep { $_ eq $symbol }
                @{ $EXPORTDEF{$pkg}{EXPORT_TAGS}{$tag} };
    }
}


sub export     { add(EXPORT    => @_) }
sub exportable { add(EXPORT_OK => @_) }


sub import {
    my $pkg = shift;

    # Only set @EXPORT, @EXPORT_OK and %EXPORT_TAGS in each exporting package
    # once.

    our $did_set_exports ||= {};

    # run this once per importing package; if several packages use
    # Exporter::Simple, this import() sub could be run several times.

    unless ($did_set_exports->{$pkg}++) {
        while (my ($exp_pkg, $def) = each our %EXPORTDEF) {
            no strict 'refs';

            # remove export cache; without this, we can't export in both BEGIN
            # and INIT phases

            undef %{ "$exp_pkg\::EXPORT" };

            # build the variables Exporter requires to do its work and ask it
            # to export the symbols we remembered during import().

            @{ "$exp_pkg\::EXPORT" }      = @{ $def->{EXPORT}      || [] };
            @{ "$exp_pkg\::EXPORT_OK" }   = @{ $def->{EXPORT_OK}   || [] };
            %{ "$exp_pkg\::EXPORT_TAGS" } = %{ $def->{EXPORT_TAGS} || {} };
        }
    }

    local $Exporter::ExportLevel = 1;
    Exporter::import($pkg => @_);
}


INIT {
    # undef some structures we don't need anymore

    undef our $source;
    undef our $did_set_exports;
    undef our %EXPORTDEF;
}


1;


__END__

{% USE p = PodGenerated %}

=head1 NAME

Exporter::Simple - Easier set-up of module exports

=head1 SYNOPSIS

  package MyExport;
  use base 'Exporter::Simple';

  our @bar : Exportable(vars) = (2, 3, 5, 7);
  our $foo : Exported(vars)   = 42;
  our %baz : Exported         = (a => 65, b => 66);

  sub hello : Exported(greet,uk)   { "hello there" }
  sub askme : Exportable           { "what you will" }
  sub hi    : Exportable(greet,us) { "hi there" }

  # meanwhile, in a module far, far away
  use MyExport qw(:greet);
  print hello();
  $baz{c} = 67;

=head1 DESCRIPTION

This module, when subclassed by a package, allows that package to define
exports in a more concise way than using C<Exporter>. Instead of having to
worry what goes in C<@EXPORT>, C<@EXPORT_OK> and C<%EXPORT_TAGS>, you can
use two attributes to define exporter behavior. This has two advantages:
It frees you from the implementation details of C<Exporter>, and it
keeps the export definitions where they belong, with the subroutines
and variables.

The attributes provided by this module are:

=over 4

=item C<Exported>

Indicates that the associated subroutine or global variable should
be automatically exported. It will also go into the C<:all> tag
(per the rules of C<%EXPORT_TAGS>), as well as any tags you specify
as options of this attribute.

For example, the following declaration

  sub hello : Exported(greet,uk)   { ... }

will cause C<hello()> to be exported, but also be available in the
tags C<:all>, C<:greet> and C<:uk>.

=item C<Exportable>

Is like C<Exported>, except that the associated subroutine or
global variable won't be automatically exported.  It will still
go to the C<:all> tag in any case and all other tags specified as
attribute options.

=back

{% PROCESS standard_pod %}

=cut

